Objectif : Dynamique de population des poissons d’eau douce de Bretagne - 10_calcul_indicateurs_par_ope

Ce script permet de constituer les premiers tableaux de données nécessaires à la préparation des analyses temporelles. Plusieurs indicateurs seront calculés à l’échelle des opérations de pêches, parmi eux : les densités volumiques, de surface, les pourcentages de juvéniles, les longueurs médianes, … Ces indicateurs sont calculés par espèces, soit séparement pour les juvéniles et les adultes, soit de manière combinée.

Installation

Chargement des packages, fonctions et des données

## Chargement des packages ----
library(tidyverse)
library(aspe)
library(ggplot2)
library(ggthemes)
library(dplyr)
library(readxl)


## Chargement des données ----
load(file = "../processed_data/selection_pop_ope.rda")
load(file = "../processed_data/pre_traitements_donnees_env.rda")
load(file = "../processed_data/analyse_selection_especes.rda")
load(file = "../processed_data/pre_traitements_donnees_especes.rda")

rdata_tables <- misc_nom_dernier_fichier(
  repertoire = "../../../../projets/ASPE/raw_data/rdata",
  pattern = "^tables")
load(rdata_tables)

mei_table <- misc_nom_dernier_fichier(
  repertoire = "../../../../projets/ASPE/raw_data/rdata",
  pattern = "^mei")
load(mei_table)

## Chargement des fonctions ----
source(file = "../R/calcul_biomasse.R")
source(file = "../R/calcul_50_percentile.R")
source(file = "../R/calcul_ecart_interquartile.R")
source(file = "../R/calcul_25_percentile.R")
source(file = "../R/calcul_75_percentile.R")
source(file = "../R/calcul_densite_surface.R")

Les indicateurs par opération de pêche

Indicateurs généraux par opération de pêche

Effectif total des espèces par opération de pêche

ope_effectif_total_stade <- mei_ope_selection %>% # Réalisation d'un df contenant les données d'effectifs selon les différents stades (ad / juv)
  group_by(ope_id,
           esp_code_alternatif,
           stade) %>%
  summarise(valeur=sum(length(mei_id))) %>% 
  mutate(indicateur= "effectif_total") %>% 
  select(ope_id,
         esp_code_alternatif,
         indicateur,
         valeur,
         stade)
  
ope_effectif_total_esp <- ope_effectif_total_stade %>% # Réalisation d'un df contenant les données d'effectifs tous stades confondus
  group_by(ope_id,
           esp_code_alternatif) %>% 
  summarise(valeur=sum(valeur)) %>% 
  mutate(indicateur= "effectif_total") %>%
  mutate (stade = "ind") %>% 
  select(ope_id,
         esp_code_alternatif,
         indicateur,
         valeur,
         stade)

ope_effectif_total <- bind_rows(ope_effectif_total_stade, ope_effectif_total_esp)

Biomasse des espèces par opération de pêche

# Calcul de la biomasse par opération : par espèce et par stade : 
ope_biomasse_stade <- mei_ope_selection %>%
    group_by(ope_id,
             esp_code_alternatif,
             stade) %>%
   summarize(valeur = sum(poids_tp, na.rm = TRUE)) %>% 
  mutate (indicateur = "biomasse")



ope_biomasse_esp <- ope_biomasse_stade %>% # Réalisation d'un df contenant les données de biomasse par espèce tous stades confondus
  group_by(ope_id,
           esp_code_alternatif) %>% 
  summarise(valeur = sum(valeur)) %>% 
  mutate(indicateur= "biomasse") %>%
  mutate (stade = "ind") %>% 
  select(ope_id,
         esp_code_alternatif,
         indicateur,
         valeur,
         stade)

ope_biomasse <- bind_rows(ope_biomasse_stade, ope_biomasse_esp)

Densité surfacique par opération

# Ajout des données de surfaces échantillonnées dans mei_ope_selection ----
mei_ope_selection <- mei_ope_selection %>% 
  left_join (y=operation %>% 
               select (ope_id, 
                       ope_surface_calculee,
                       passage$pas_numero))

Partie optionnelle : Vérification du Jeu De Données : Je vérifie que j’ai autant de ligne lop_id que lop_effectif (sauf quand le lot est S/M et à une valeur de 30) :

# verif_effectif <- mei_ope_selection %>% 
#   group_by(lop_id,lop_effectif) %>% 
#   summarise(nbr_lignes = n()) %>% 
#   ungroup()
# 
# resultat_verif_effectif <- verif_effectif %>% 
#   filter(nbr_lignes!= lop_effectif)

Je vérifie que je n’ai qu’un mei_id par ligne (et pas de doublons) : “nb_unique doit” être égal au nombre total de lignes dans la colonne.

#nb_unique <- mei_ope_selection %>% 
#  summarise(nb_unique = n_distinct(mei_id))

# print(nb_unique)
# ------------------------------------------------------------------------------
# Ajout des effectifs dans un df ope_densite_stade ----
ope_densite_stade_eff <- mei_ope_selection %>% 
  group_by(ope_id,
           esp_code_alternatif,
           ope_surface_calculee,
           stade) %>% 
  summarise(effectif= n_distinct(mei_id)) %>% 
  ungroup() %>% 
  mutate(indicateur= "densite_surface")

resultats_densite <- calcul_densite_surface(mei_ope_selection,
                                            ope_surface_calculee,
                                            ope_id,esp_code_alternatif, 
                                            stade,
                                            mei_id)

ope_densite_surface <- resultats_densite$df1 
ope_densite_surface_esp <- resultats_densite$df2 
ope_densite_surface_stade <- resultats_densite$df3 

Densité volumique par opération

!! ATTENTION !! : Ici je n’ai pas réussie à mettre en fonction !

#Ajout des données de profondeurs :
ope_selection_param_profondeur <- ope_selection_param_env %>% 
  filter(parametre == "profondeur") %>% 
  select(ope_id,
         valeur) %>% 
  rename(ope_valeur_profondeur=valeur) %>% 
  distinct()


ope_densite_surface_1 <- ope_densite_surface %>% 
  rename(valeur_ds = valeur)


ope_densite_vol<- left_join(ope_selection_param_profondeur, ope_densite_surface_1, by = "ope_id") %>% 
  mutate(valeur = valeur_ds /ope_valeur_profondeur) %>%
  ungroup() %>% 
  mutate(indicateur = "densite_volumique") %>% 
  select(ope_id, 
         esp_code_alternatif, 
         indicateur,
         valeur,
         stade)

ope_densite_volume_stade <- ope_densite_vol %>% 
  filter (stade == "juv"| stade == "ad")

ope_densite_volume_esp <- ope_densite_vol %>% 
  filter (stade == "ind")

Pourcentage de juvéniles par opération

!! ATTENTION !! : Ici je n’ai pas réussie à mettre en fonction !

########################## POURCENTAGE DE JUVENILES ############################
# Calcul des pourcentages de juvéniles pour les différents stades des espèces (juvéniles / adultes) ----
ope_pc_juv_stade_eff <- mei_ope_selection %>%
  group_by(ope_id,
           esp_code_alternatif,
           stade) %>% 
  summarise(#effectif=sum(length(mei_id)),
            #effectif2 = n_distinct(mei_id),
            effectif = n()) %>% 
  ungroup() %>% 
  mutate(indicateur = "pourcentage_juveniles")

ope_pc_juv_stade_eff2 <- mei_ope_selection %>%
  group_by(ope_id,
           esp_code_alternatif) %>% 
  summarise(#effectif=sum(length(mei_id)),
            #effectif2 = n_distinct(mei_id),
            effectif = n()) %>% 
  ungroup() %>% 
  mutate(indicateur = "pourcentage_juveniles",
         stade = "ind") %>% 
  select(names(ope_pc_juv_stade_eff))

ope_pc_juv_stade_eff <- ope_pc_juv_stade_eff %>% 
  rbind(ope_pc_juv_stade_eff2)
ope_pc_juv <- ope_pc_juv_stade_eff %>% 
  complete(ope_id,
           esp_code_alternatif,
           stade,
           indicateur,
           fill = list(effectif = 0)) %>% 
    group_by(ope_id,
             esp_code_alternatif) %>% 
  mutate(valeur = effectif[stade == "juv"] / effectif[stade == "ind"]) %>% 
  filter(stade == "ind",
         !is.nan(valeur)) %>% 
  select(-effectif)

Indicateurs sur les mesures individuelles par opération de pêche

Longueur médiane

Calcul des longueurs médianes des tailles des individus par opération : Création de la fonction “calcul_50_percentile” :

resultats_longueur_mediane <- calcul_50_percentile(mei_ope_selection,mei_taille,ope_id,esp_code_alternatif, stade)
ope_50_percentile <- resultats_longueur_mediane$df1 # Construction d'un Df avec les longueurs médianes des espèces par opération toutes tailles confondues + des différents stades ----
ope_50_percentile_esp <- resultats_longueur_mediane$df2 # Construction d'un Df avec les longueurs médianes des espèces par opération toutes tailles confondues ----
ope_50_percentile_stade <- resultats_longueur_mediane$df3 # Construction d'un Df avec les longueurs médianes des différents stades des espèces (juvéniles / adultes) ----

Ecart interquartile

Calcul des écarts interquartiles des tailles des individus par opération : Création de la fonction “calcul_ecart_interquartile” :

#########################    ECART INTERQUARTILE   #############################
resultats_ecart_interquartile <- calcul_ecart_interquartile(mei_ope_selection,mei_taille,ope_id,esp_code_alternatif, stade)
ope_ecart_interqua <- resultats_ecart_interquartile$df1 # Construction d'un Df avec les écarts interquartiles des espèces par opération toutes tailles confondues + des différents stades ----
ope_ecart_interqua_esp <- resultats_ecart_interquartile$df2 # Construction d'un Df des écarts interquartiles des espèces par opération toutes tailles confondues ----
ope_ecart_interqua_stade <- resultats_ecart_interquartile$df3 # Construction d'un df des écarts interquartiles des tailles des différents stades des espèces (juvéniles / adultes) ----

Percentiles 25 et 75

Calcul des percentiles 25 et 75 des tailles des individus par opération : Création de la fonction “calcul_25_percentile” et “calcul_75_percentile” :

resultats_25_percentile <- calcul_25_percentile(mei_ope_selection,mei_taille,ope_id,esp_code_alternatif, stade)
ope_25_percentile <- resultats_25_percentile$df1 # Construction d'un Df des percentiles 25 des espèces par opération toutes tailles confondues + des différents stades ----
ope_25_percentile_esp <- resultats_25_percentile$df2 # Construction d'un Df des percentiles 25 des espèces par opération toutes tailles confondues ----
ope_25_percentile_stade <- resultats_25_percentile$df3 # Construction d'un df des percentiles 25 des tailles des différents stades des espèces (juvéniles / adultes) ----


resultats_75_percentile <- calcul_75_percentile(mei_ope_selection,mei_taille,ope_id,esp_code_alternatif, stade)
ope_75_percentile <- resultats_75_percentile$df1 # Construction d'un Df des percentiles 75 des espèces par opération toutes tailles confondues + des différents stades ----
ope_75_percentile_esp <- resultats_75_percentile$df2 # Construction d'un Df des percentiles 75 des espèces par opération toutes tailles confondues ----
ope_75_percentile_stade <- resultats_75_percentile$df3 # Construction d'un df des percentiles 75 des tailles des différents stades des espèces (juvéniles / adultes) ----

On calcul le pourcentage des sites prospectés où l’espèce a été trouvée

combinaisons <- expand.grid(esp_code_alternatif = unique(ope_biomasse_esp$esp_code_alternatif),
                            ope_id = unique(ope_biomasse_esp$ope_id))

# Fusionner les combinaisons avec le dataframe initial
reg_pc_presence_esp <- combinaisons %>%
  left_join(ope_biomasse_esp, by = c("esp_code_alternatif", "ope_id")) %>%
  mutate(present = !is.na(indicateur)) %>%
  group_by(esp_code_alternatif) %>%
  mutate(stade = "ind",
         indicateur = "pourcentage_presence_esp",
         valeur = sum(present) / n_distinct(ope_id) * 100) %>% 
  select(-present)
  

# Affichage du résultat
print(reg_pc_presence_esp)
## # A tibble: 25,224 × 5
## # Groups:   esp_code_alternatif [24]
##    esp_code_alternatif ope_id indicateur               valeur stade
##    <chr>                <int> <chr>                     <dbl> <chr>
##  1 ANG                   5131 pourcentage_presence_esp  81.0  ind  
##  2 TRF                   5131 pourcentage_presence_esp  81.3  ind  
##  3 VAI                   5131 pourcentage_presence_esp  61.5  ind  
##  4 LOF                   5131 pourcentage_presence_esp  73.8  ind  
##  5 LPP                   5131 pourcentage_presence_esp  46.1  ind  
##  6 SAT                   5131 pourcentage_presence_esp  45.5  ind  
##  7 BRO                   5131 pourcentage_presence_esp  20.4  ind  
##  8 CCO                   5131 pourcentage_presence_esp   1.81 ind  
##  9 CHA                   5131 pourcentage_presence_esp  67.4  ind  
## 10 EPI                   5131 pourcentage_presence_esp   1.33 ind  
## # ℹ 25,214 more rows

Création du tableau final empilé des indicateurs

# Création du tableau pré-final avec tous les indicateurs calculés
ope_indicateur <- rbind(ope_50_percentile,
                        #ope_ecart_interqua,
                        #ope_25_percentile,
                        #ope_75_percentile,
                        ope_densite_surface,
                        ope_densite_vol,
                        ope_pc_juv,
                        ope_biomasse,
                        ope_effectif_total,
                        reg_pc_presence_esp)

# Ajout des années d'opération au site et à l'année (pop_id) et (ope_date)
ope_indicateur <- ope_indicateur %>% 
  left_join(y=operation %>% 
              select(ope_id,
                     pop_id= ope_pop_id,
                     ope_date)) 

ope_indicateur <- ope_indicateur %>% 
  mef_ajouter_ope_date()

ope_indicateur <- ope_indicateur %>% 
  select(ope_id, 
         esp_code_alternatif,
         indicateur,
         valeur,
         stade,
         pop_id,
         annee)

#Représentation graphique du tableau 
ope_indicateur%>%
  DT::datatable(rownames = FALSE)

Sauvegarde

# SAUVEGARDE ----
save(ope_indicateur,
     file = "../processed_data/assemblage_tab_par_ope.rda")